home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Visual Basic Toolbox
/
Visual Basic Toolbox (P.I.E.)(1996).ISO
/
forms
/
frmwiz
/
fieldfrm.frm
< prev
next >
Wrap
Text File
|
1995-01-14
|
11KB
|
395 lines
VERSION 2.00
Begin Form FieldFrm
BackColor = &H00C0C0C0&
BorderStyle = 1 'Fixed Single
Caption = "Form Wizard - Field Selection"
ClientHeight = 5115
ClientLeft = 1095
ClientTop = 1260
ClientWidth = 7845
ControlBox = 0 'False
Height = 5520
HelpContextID = 26
Icon = FIELDFRM.FRX:0000
Left = 1035
LinkTopic = "Form2"
ScaleHeight = 5115
ScaleWidth = 7845
Top = 915
Width = 7965
Begin SSCommand BtnHelp
Caption = "&Help"
Font3D = 2 'Raised w/heavy shading
Height = 615
Left = 4860
Picture = FIELDFRM.FRX:0302
TabIndex = 11
Top = 4020
Width = 915
End
Begin SSPanel cMsg
Align = 2 'Align Bottom
Alignment = 1 'Left Justify - MIDDLE
BevelInner = 1 'Inset
BorderWidth = 2
Height = 375
Left = 0
TabIndex = 10
Top = 4740
Width = 7845
End
Begin SSCommand BtnFinish
AutoSize = 2 'Adjust Button Size To Picture
Caption = "&Finish"
Enabled = 0 'False
Font3D = 2 'Raised w/heavy shading
Height = 615
Left = 3960
Picture = FIELDFRM.FRX:0604
TabIndex = 9
Top = 4020
Width = 915
End
Begin SSCommand BtnCancel
AutoSize = 2 'Adjust Button Size To Picture
Caption = "&Cancel"
Font3D = 2 'Raised w/heavy shading
Height = 615
Left = 3060
Picture = FIELDFRM.FRX:0906
TabIndex = 6
Tag = "Cancel building the form"
Top = 4020
Width = 915
End
Begin SSCommand BtnNext
AutoSize = 2 'Adjust Button Size To Picture
Caption = "&Next"
Font3D = 2 'Raised w/heavy shading
Height = 615
Left = 2160
Picture = FIELDFRM.FRX:0C08
TabIndex = 5
Tag = "Proceed to the next step"
Top = 4020
Width = 915
End
Begin SSCommand BtnPrev
AutoSize = 2 'Adjust Button Size To Picture
Caption = "&Previous"
Font3D = 2 'Raised w/heavy shading
Height = 615
Left = 1260
Picture = FIELDFRM.FRX:0F0A
TabIndex = 4
Tag = "Return to the previous step"
Top = 4020
Width = 915
End
Begin SSFrame FramFldsOnForm
Alignment = 2 'Center
Caption = "Fields On Form"
ForeColor = &H00FF0000&
Height = 3675
Left = 3900
TabIndex = 8
Top = 240
Width = 3795
Begin Grid GrdFields
Cols = 4
FixedRows = 0
Height = 3315
Left = 120
Rows = 1
TabIndex = 2
Tag = "Select one or more fields, right click to change attributes"
Top = 240
Width = 3555
End
End
Begin SSFrame Frame3D1
Alignment = 2 'Center
Caption = "Select Fields For Form"
ForeColor = &H00FF0000&
Height = 3735
Left = 120
TabIndex = 7
Top = 180
Width = 2595
Begin ListBox LstFields
BackColor = &H00C0C0C0&
Height = 3345
Left = 120
MultiSelect = 2 'Extended
TabIndex = 0
Tag = "Select one or more fields to add to the form"
Top = 300
Width = 2355
End
End
Begin SSCommand BtnRemove
AutoSize = 2 'Adjust Button Size To Picture
Caption = "&Remove"
Font3D = 2 'Raised w/heavy shading
Height = 555
Left = 2820
Picture = FIELDFRM.FRX:120C
TabIndex = 3
Tag = "Remove selected field(s) from the form"
Top = 1200
Width = 975
End
Begin SSCommand BtnAdd
AutoSize = 2 'Adjust Button Size To Picture
Caption = "&Add"
Font3D = 2 'Raised w/heavy shading
Height = 555
Left = 2820
Picture = FIELDFRM.FRX:150E
TabIndex = 1
Tag = "Add selected field(s) to the form"
Top = 600
Width = 975
End
End
Option Explicit
Dim maxwidth(3) As Long
Sub BtnAdd_Click ()
Dim i As Integer, fld As String
' Add selected feilds to grid
For i = 0 To LstFields.ListCount - 1
If LstFields.Selected(i) Then
fld = LstFields.List(i)
GrdFields.AddItem fld & Chr$(9) & fld & Chr$(9) & "No" & Chr$(9) & Str$(aiFldSize(i))
If TextWidth(fld) + 150 > maxwidth(0) Then
maxwidth(0) = TextWidth(fld) + 150
GrdFields.ColWidth(0) = maxwidth(0)
End If
If TextWidth(fld) + 150 > maxwidth(1) Then
maxwidth(1) = TextWidth(fld) + 150
GrdFields.ColWidth(1) = maxwidth(1)
End If
End If
Next i
If GrdFields.Rows > 1 Then GrdFields.FixedRows = 1
End Sub
Sub BtnAdd_GotFocus ()
cMsg.Caption = BtnAdd.Tag
End Sub
Sub BtnCancel_Click ()
EndItNow
End Sub
Sub BtnCancel_GotFocus ()
cMsg.Caption = BtnCancel.Tag
End Sub
Sub BtnHelp_Click ()
SendKeys "{F1}"
End Sub
Sub BtnNext_Click ()
Dim contanyway As Integer
Dim msg As String
If GrdFields.Rows = 1 Then
Beep
msg = "You haven't specified any fields for the form! Do you want to continue anyway?"
contanyway = MsgBox(msg, MB_ICONQUESTION + MB_YESNO, "Field Selection")
If contanyway = IDNO Then
Exit Sub
End If
End If
GenForm.Show MODELESS
FieldFrm.Hide
End Sub
Sub BtnNext_GotFocus ()
cMsg.Caption = BtnNext.Tag
End Sub
Sub BtnPrev_Click ()
DataSpec.Show MODELESS
FieldFrm.Hide
End Sub
Sub BtnPrev_GotFocus ()
cMsg.Caption = BtnPrev.Tag
End Sub
Sub BtnRemove_Click ()
On Error GoTo removeerr
Dim i As Integer, i2 As Integer
' Remove any selected rows except the last one
For i = GrdFields.Rows - 2 To 0 Step -1
GrdFields.Row = i
GrdFields.Col = 1
If GrdFields.CellSelected Then
GrdFields.RemoveItem i
End If
Next i
' Check if last row is deleted and handle special to prevent error
' caused by selection defaulting to the entire table when the last
' row is removed
i = GrdFields.Rows - 1
GrdFields.Row = i
GrdFields.Col = 1
If GrdFields.CellSelected Then
GrdFields.FixedRows = 0
GrdFields.RemoveItem i
End If
GrdFields.Refresh
If GrdFields.Rows > 1 Then GrdFields.FixedRows = 1
Exit Sub
removeerr:
erraction = RB_ErrorHandler("FieldFrm", "BtnRemove_Click")
Select Case erraction
Case 1
Resume 0 ' Retry option selected
Case 2
Resume Next ' Ignore option selected
End Select
End Sub
Sub BtnRemove_GotFocus ()
cMsg.Caption = BtnRemove.Tag
End Sub
Sub Form_Activate ()
Dim ds As dynaset, ssfields As snapshot
Dim iNumFlds As Integer
On Error GoTo formacterr
' Load list of fields in record source
If NewRecordSource Then
Set ds = db.CreateDynaset(DataSpec.LstRecSrce.Text)
Set ssfields = ds.ListFields()
ds.Close
LstFields.Clear
ReDim aiFldSize(1)
iNumFlds = -1
Do While Not ssfields.EOF
LstFields.AddItem ssfields!Name
iNumFlds = iNumFlds + 1
ReDim Preserve aiFldSize(iNumFlds)
aiFldSize(iNumFlds) = ssfields!Size
ssfields.MoveNext
Loop
ssfields.Close
NewRecordSource = False
' Clear the grid of fields
GrdFields.Rows = 1
End If
Exit Sub
formacterr:
erraction = RB_ErrorHandler("FieldFrm", "Form_Activate")
Select Case erraction
Case 1
Resume 0 ' Retry option selected
Case 2
Resume Next ' Ignore option selected
End Select
End Sub
Sub Form_Load ()
On Error GoTo loaderr
' Set up grid headings
GrdFields.Row = 0
GrdFields.Col = 0
GrdFields.Text = "Field"
GrdFields.ColWidth(0) = TextWidth(" Field ")
maxwidth(0) = GrdFields.ColWidth(0)
GrdFields.Col = 1
GrdFields.Text = "Label"
GrdFields.ColWidth(1) = TextWidth(" Label ")
maxwidth(1) = GrdFields.ColWidth(1)
GrdFields.Col = 2
GrdFields.Text = "Same" & Chr$(13) & "Line"
GrdFields.ColWidth(2) = TextWidth(" Same ")
maxwidth(2) = GrdFields.ColWidth(2)
GrdFields.Col = 3
GrdFields.Text = "Size"
GrdFields.ColWidth(3) = TextWidth(" Size ")
GrdFields.RowHeight(0) = 2 * TextHeight("Same")
Exit Sub
loaderr:
erraction = RB_ErrorHandler("FieldFrm", "Form_Load")
Select Case erraction
Case 1
Resume 0 ' Retry option selected
Case 2
Resume Next ' Ignore option selected
End Select
End Sub
Sub Form_Resize ()
If FieldFrm.WindowState <> 1 Then
FramFldsOnForm.Width = FieldFrm.Width - FramFldsOnForm.Left - 250
GrdFields.Width = FramFldsOnForm.Width - GrdFields.Left - 150
End If
End Sub
Sub GrdFields_GotFocus ()
cMsg.Caption = GrdFields.Tag
End Sub
Sub GrdFields_MouseUp (Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim i As Integer, istart As Integer, iend As Integer
If Button = RIGHT_BUTTON Then
istart = GrdFields.SelStartRow
If istart = 0 Then istart = 1
iend = GrdFields.SelEndRow
For i = istart To iend
GrdFields.Row = i
GrdFields.Col = 0
ChngFld.LblField.Caption = GrdFields.Text
GrdFields.Col = 1
ChngFld.TxtLabel = GrdFields.Text
GrdFields.Col = 2
If GrdFields.Text = "Yes" Then
ChngFld.ChkSameLine.Value = True
Else
ChngFld.ChkSameLine.Value = False
End If
ChngFld.LblRow.Caption = Str$(i)
ChngFld.Show MODAL
Next i
End If
End Sub
Sub LstFields_GotFocus ()
cMsg.Caption = LstFields.Tag
End Sub
